home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / UXTRAP.C < prev    next >
C/C++ Source or Header  |  1992-03-26  |  23KB  |  804 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/uxtrap.c,v 1.19 1992/03/26 10:59:14 cph Exp $
  4.  
  5. Copyright (c) 1990-92 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. #include "scheme.h"
  36. #include "ux.h"
  37. #include "uxtrap.h"
  38. #include "uxutil.h"
  39. #include "option.h"
  40.  
  41. extern CONST char * EXFUN (find_signal_name, (int signo));
  42. extern void EXFUN (UX_dump_core, (void));
  43. extern PTR initial_C_stack_pointer;
  44.  
  45. static enum trap_state trap_state;
  46. static enum trap_state user_trap_state;
  47.  
  48. static enum trap_state saved_trap_state;
  49. static int saved_signo;
  50. static SIGINFO_T saved_info;
  51. static struct FULL_SIGCONTEXT * saved_scp;
  52.  
  53. static void EXFUN (initialize_ux_signal_codes, (void));
  54. static void EXFUN
  55.   (continue_from_trap,
  56.    (int signo, SIGINFO_T info, struct FULL_SIGCONTEXT * scp));
  57.  
  58. void
  59. DEFUN_VOID (UX_initialize_trap_recovery)
  60. {
  61.   trap_state = trap_state_recover;
  62.   user_trap_state = trap_state_recover;
  63.   initialize_ux_signal_codes ();
  64. }
  65.  
  66. enum trap_state
  67. DEFUN (OS_set_trap_state, (state), enum trap_state state)
  68. {
  69.   enum trap_state old_trap_state = user_trap_state;
  70.   user_trap_state = state;
  71.   trap_state = state;
  72.   return (old_trap_state);
  73. }
  74.  
  75. static void
  76. DEFUN_VOID (trap_normal_termination)
  77. {
  78.   trap_state = trap_state_exitting_soft;
  79.   termination_trap ();
  80. }
  81.  
  82. static void
  83. DEFUN_VOID (trap_immediate_termination)
  84. {
  85.   trap_state = trap_state_exitting_hard;
  86.   OS_restore_external_state ();
  87.   exit (1);
  88. }
  89.  
  90. static void
  91. DEFUN_VOID (trap_dump_core)
  92. {
  93.   if (option_disable_core_dump)
  94.     {
  95.       fputs (">> Core dumps are disabled - Terminating normally.\n", stdout);
  96.       fflush (stdout);
  97.       termination_trap ();
  98.     }
  99.   else
  100.     UX_dump_core ();
  101. }
  102.  
  103. static void
  104. DEFUN_VOID (trap_recover)
  105. {
  106.   if (WITHIN_CRITICAL_SECTION_P ())
  107.     {
  108.       CLEAR_CRITICAL_SECTION_HOOK ();
  109.       EXIT_CRITICAL_SECTION ({});
  110.     }
  111.   reset_interruptable_extent ();
  112.   continue_from_trap (saved_signo, saved_info, saved_scp);
  113. }
  114.  
  115. void
  116. DEFUN (trap_handler, (message, signo, info, scp),
  117.        CONST char * message AND
  118.        int signo AND
  119.        SIGINFO_T info AND
  120.        struct FULL_SIGCONTEXT * scp)
  121. {
  122.   int code = ((SIGINFO_VALID_P (info)) ? (SIGINFO_CODE (info)) : 0);
  123.   Boolean constant_space_broken = (!(CONSTANT_SPACE_SEALED ()));
  124.   enum trap_state old_trap_state = trap_state;
  125.  
  126.   if (old_trap_state == trap_state_exitting_hard)
  127.   {
  128.     _exit (1);
  129.   }
  130.   else if (old_trap_state == trap_state_exitting_soft)
  131.   {
  132.     trap_immediate_termination ();
  133.   }
  134.   trap_state = trap_state_trapped;
  135.   if (WITHIN_CRITICAL_SECTION_P ())
  136.   {
  137.     fprintf (stdout,
  138.          "\n>> A %s has occurred within critical section \"%s\".\n",
  139.          message, (CRITICAL_SECTION_NAME ()));
  140.     fprintf (stdout, ">> [signal %d (%s), code %d]\n",
  141.          signo, (find_signal_name (signo)), code);
  142.   }
  143.   else if (constant_space_broken || (old_trap_state != trap_state_recover))
  144.   {
  145.     fprintf (stdout, "\n>> A %s has occurred.\n", message);
  146.     fprintf (stdout, ">> [signal %d (%s), code %d]\n",
  147.          signo, (find_signal_name (signo)), code);
  148.   }
  149.   if (constant_space_broken)
  150.   {
  151.     fputs (">> Constant space has been overwritten.\n", stdout);
  152.     fputs (">> Probably a runaway recursion has overflowed the stack.\n",
  153.        stdout);
  154.   }
  155.   fflush (stdout);
  156.  
  157.   switch (old_trap_state)
  158.   {
  159.   case trap_state_trapped:
  160.     if ((saved_trap_state == trap_state_recover) ||
  161.     (saved_trap_state == trap_state_query))
  162.     {
  163.       fputs (">> The trap occurred while processing an earlier trap.\n",
  164.          stdout);
  165.       fprintf (stdout,
  166.            ">> [The earlier trap raised signal %d (%s), code %d.]\n",
  167.            saved_signo,
  168.            (find_signal_name (saved_signo)),
  169.            ((SIGINFO_VALID_P (saved_info))
  170.         ? (SIGINFO_CODE (saved_info))
  171.         : 0));
  172.       fputs (((WITHIN_CRITICAL_SECTION_P ())
  173.           ? ">> Successful recovery is extremely unlikely.\n"
  174.           : ">> Successful recovery is unlikely.\n"),
  175.          stdout);
  176.       break;
  177.     }
  178.     else
  179.       trap_immediate_termination ();
  180.   case trap_state_recover:
  181.     if ((WITHIN_CRITICAL_SECTION_P ()) || constant_space_broken)
  182.     {
  183.       fputs (">> Successful recovery is unlikely.\n", stdout);
  184.       break;
  185.     }
  186.     else
  187.     {
  188.       saved_trap_state = old_trap_state;
  189.       saved_signo = signo;
  190.       saved_info = info;
  191.       saved_scp = scp;
  192.       trap_recover ();
  193.     }
  194.   case trap_state_exit:
  195.     termination_trap ();
  196.   }
  197.  
  198.   fflush (stdout);
  199.   saved_trap_state = old_trap_state;
  200.   saved_signo = signo;
  201.   saved_info = info;
  202.   saved_scp = scp;
  203.     
  204.   while (1)
  205.   {
  206.     static CONST char * trap_query_choices[] =
  207.     {
  208.       "D = dump core",
  209.       "I = terminate immediately",
  210.       "N = terminate normally",
  211.       "R = attempt recovery",
  212.       "Q = terminate normally",
  213.       0
  214.       };
  215.     switch (userio_choose_option
  216.         ("Choose one of the following actions:",
  217.          "Action -> ",
  218.          trap_query_choices))
  219.     {
  220.     case 'I':
  221.       trap_immediate_termination ();
  222.     case 'D':
  223.       trap_dump_core ();
  224.     case '\0':
  225.       /* Error in IO. Assume everything scrod. */
  226.     case 'N':
  227.     case 'Q':
  228.       trap_normal_termination ();
  229.     case 'R':
  230.       trap_recover ();
  231.     }
  232.   }
  233. }
  234.  
  235. #define STATE_UNKNOWN        (LONG_TO_UNSIGNED_FIXNUM (0))
  236. #define STATE_PRIMITIVE        (LONG_TO_UNSIGNED_FIXNUM (1))
  237. #define STATE_COMPILED_CODE    (LONG_TO_UNSIGNED_FIXNUM (2))
  238. #define STATE_PROBABLY_COMPILED    (LONG_TO_UNSIGNED_FIXNUM (3))
  239.  
  240. struct trap_recovery_info
  241. {
  242.   SCHEME_OBJECT state;
  243.   SCHEME_OBJECT pc_info_1;
  244.   SCHEME_OBJECT pc_info_2;
  245.   SCHEME_OBJECT extra_trap_info;
  246. };
  247.  
  248. static struct trap_recovery_info dummy_recovery_info =
  249. {
  250.   STATE_UNKNOWN,
  251.   SHARP_F,
  252.   SHARP_F,
  253.   SHARP_F
  254. };
  255.  
  256. struct ux_sig_code_desc
  257. {
  258.   int signo;
  259.   unsigned long code_mask;
  260.   unsigned long code_value;
  261.   char *name;
  262. };
  263.  
  264. static struct ux_sig_code_desc ux_signal_codes [64];
  265.  
  266. #define DECLARE_UX_SIGNAL_CODE(s, m, v, n)                \
  267. {                                    \
  268.   ((ux_signal_codes [i]) . signo) = (s);                \
  269.   ((ux_signal_codes [i]) . code_mask) = (m);                \
  270.   ((ux_signal_codes [i]) . code_value) = (v);                \
  271.   ((ux_signal_codes [i]) . name) = (n);                    \
  272.   i += 1;                                \
  273. }
  274.  
  275. static void
  276. DEFUN_VOID (initialize_ux_signal_codes)
  277. {
  278.   unsigned int i = 0;
  279.   INITIALIZE_UX_SIGNAL_CODES ();
  280.   DECLARE_UX_SIGNAL_CODE (0, 0, 0, ((char *) 0));
  281. }
  282.  
  283. static SCHEME_OBJECT
  284. DEFUN (find_signal_code_name, (signo, info, scp),
  285.        int signo AND
  286.        SIGINFO_T info AND
  287.        struct FULL_SIGCONTEXT * scp)
  288. {
  289.   unsigned long code = 0;
  290.   char * name = 0;
  291.   if (SIGINFO_VALID_P (info))
  292.     {
  293.       code = (SIGINFO_CODE (info));
  294. #ifdef SPECIAL_SIGNAL_CODE_NAMES
  295.       SPECIAL_SIGNAL_CODE_NAMES ();
  296.       if (name == 0)
  297. #endif
  298.     {
  299.       struct ux_sig_code_desc * entry = (& (ux_signal_codes [0]));
  300.       while ((entry -> signo) != 0)
  301.         if (((entry -> signo) == signo)
  302.         && (((entry -> code_mask) & code) == (entry -> code_value)))
  303.           {
  304.         name = (entry -> name);
  305.         break;
  306.           }
  307.         else
  308.           entry += 1;
  309.     }
  310.     }
  311.   return (cons ((long_to_integer ((long) code)),
  312.         ((name == 0) ? SHARP_F
  313.          : (char_pointer_to_string ((unsigned char *) name)))));
  314. }
  315.  
  316. static void
  317. DEFUN (setup_trap_frame, (signo, info, scp, trinfo, new_stack_pointer),
  318.        int signo AND
  319.        SIGINFO_T info AND
  320.        struct FULL_SIGCONTEXT * scp AND
  321.        struct trap_recovery_info * trinfo AND
  322.        SCHEME_OBJECT * new_stack_pointer)
  323. {
  324.   SCHEME_OBJECT handler;
  325.   SCHEME_OBJECT signal_name, signal_code;
  326.   int stack_recovered_p = (new_stack_pointer != 0);
  327.   long saved_mask = (FETCH_INTERRUPT_MASK ());
  328.   SET_INTERRUPT_MASK (0);    /* To prevent GC for now. */
  329.   if ((! (Valid_Fixed_Obj_Vector ())) ||
  330.       ((handler = (Get_Fixed_Obj_Slot (Trap_Handler))) == SHARP_F))
  331.     {
  332.       fprintf (stderr, "There is no trap handler for recovery!\n");
  333.       fflush (stderr);
  334.       termination_trap ();
  335.     }
  336.   if (Free > MemTop)
  337.   {
  338.     Request_GC (0);
  339.   }
  340.   signal_name =
  341.     ((signo == 0)
  342.      ? SHARP_F
  343.      : (char_pointer_to_string
  344.     ((unsigned char *) (find_signal_name (signo)))));
  345.   signal_code = (find_signal_code_name (signo, info, scp));
  346.   if (!stack_recovered_p)
  347.     {
  348.       Initialize_Stack ();
  349.      Will_Push (CONTINUATION_SIZE);
  350.       Store_Return (RC_END_OF_COMPUTATION);
  351.       Store_Expression (SHARP_F);
  352.       Save_Cont ();
  353.      Pushed ();
  354.     }
  355.   else
  356.     Stack_Pointer = new_stack_pointer;
  357.  Will_Push (7 + CONTINUATION_SIZE);
  358.   STACK_PUSH (trinfo -> extra_trap_info);
  359.   STACK_PUSH (trinfo -> pc_info_2);
  360.   STACK_PUSH (trinfo -> pc_info_1);
  361.   STACK_PUSH (trinfo -> state);
  362.   STACK_PUSH (BOOLEAN_TO_OBJECT (stack_recovered_p));
  363.   STACK_PUSH (signal_code);
  364.   STACK_PUSH (signal_name);
  365.   Store_Return (RC_HARDWARE_TRAP);
  366.   Store_Expression (long_to_integer (signo));
  367.   Save_Cont ();
  368.  Pushed ();
  369.   if (stack_recovered_p
  370.       /* This may want to do it in other cases, but this may be enough. */
  371.       && (trinfo->state == STATE_COMPILED_CODE))
  372.   {
  373.     Stop_History ();
  374.   }
  375.   History = (Make_Dummy_History ());
  376.  Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
  377.   STACK_PUSH (signal_name);
  378.   STACK_PUSH (handler);
  379.   STACK_PUSH (STACK_FRAME_HEADER + 1);
  380.  Pushed ();
  381.   SET_INTERRUPT_MASK (saved_mask);
  382.   abort_to_interpreter (PRIM_APPLY);
  383. }
  384.  
  385. /* 0 is an invalid signal, it means a user requested reset. */
  386.  
  387. void
  388. DEFUN (hard_reset, (scp), struct FULL_SIGCONTEXT * scp)
  389. {
  390.   continue_from_trap (0, 0, scp);
  391. }
  392.  
  393. /* Called synchronously. */
  394.  
  395. void
  396. DEFUN_VOID (soft_reset)
  397. {
  398.   struct trap_recovery_info trinfo;
  399.   SCHEME_OBJECT * new_stack_pointer =
  400.     (((Stack_Pointer <= Stack_Top) && (Stack_Pointer > Stack_Guard))
  401.      ? Stack_Pointer
  402.      : 0);
  403.   if ((Regs[REGBLOCK_PRIMITIVE]) != SHARP_F)
  404.     {
  405.       (trinfo . state) = STATE_PRIMITIVE;
  406.       (trinfo . pc_info_1) = (Regs[REGBLOCK_PRIMITIVE]);
  407.       (trinfo . pc_info_2) =
  408.     (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS]));
  409.       (trinfo . extra_trap_info) = SHARP_F;
  410.     }
  411.   else
  412.     {
  413.       (trinfo . state) = STATE_UNKNOWN;
  414.       (trinfo . pc_info_1) = SHARP_F;
  415.       (trinfo . pc_info_2) = SHARP_F;
  416.       (trinfo . extra_trap_info) = SHARP_F;
  417.     }
  418.   if ((Free >= Heap_Top) || (Free < Heap_Bottom))
  419.     /* Let's hope this works. */
  420.     Free = MemTop;
  421.   setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
  422. }
  423.  
  424. #if !defined(HAVE_SIGCONTEXT) || !defined(HAS_COMPILER_SUPPORT) || defined(USE_STACKLETS)
  425.  
  426. static void
  427. DEFUN (continue_from_trap, (signo, info, scp),
  428.        int signo AND
  429.        SIGINFO_T info AND
  430.        struct FULL_SIGCONTEXT * scp)
  431. {
  432.   if (Free < MemTop)
  433.   {
  434.     Free = MemTop;
  435.   }
  436.   setup_trap_frame (signo, info, scp, (&dummy_recovery_info), 0);
  437. }
  438.  
  439. #else /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
  440.  
  441. /* Heuristic recovery from Unix signals (traps).
  442.  
  443.    continue_from_trap attempts to:
  444.  
  445.    1) validate the trap information (pc and sp);
  446.    2) determine whether compiled code was executing, a primitive was
  447.       executing, or execution was in the interpreter;
  448.    3) guess what C global state is still valid; and
  449.    4) set up a recovery frame for the interpreter so that debuggers can
  450.       display more information. */
  451.  
  452. #include "gccode.h"
  453.  
  454. #define SCHEME_ALIGNMENT_MASK        ((sizeof (long)) - 1)
  455. #define STACK_ALIGNMENT_MASK        SCHEME_ALIGNMENT_MASK
  456. #define FREE_PARANOIA_MARGIN        0x100
  457.  
  458. /* PCs must be aligned according to this. */
  459.  
  460. #define PC_ALIGNMENT_MASK        ((1 << PC_ZERO_BITS) - 1)
  461.  
  462. /* But they may have bits that can be masked by this. */
  463.  
  464. #ifndef PC_VALUE_MASK
  465. #define PC_VALUE_MASK            (~0)
  466. #endif
  467.  
  468. #define C_STACK_SIZE            0x01000000
  469.  
  470. #ifdef HAS_COMPILER_SUPPORT
  471. #define ALLOW_ONLY_C 0
  472. #else
  473. #define ALLOW_ONLY_C 1
  474. #define PLAUSIBLE_CC_BLOCK_P(block) 0
  475. #endif
  476.  
  477. static SCHEME_OBJECT * EXFUN
  478.   (find_block_address, (char * pc_value, SCHEME_OBJECT * area_start));
  479.  
  480. #if !(defined (_NEXTOS) && (_NEXTOS_VERSION >= 20))
  481. #if !(defined (_HPUX) && (_HPUX_VERSION >= 80) && defined (hp9000s300))
  482. extern long etext;
  483. #endif
  484. #define get_etext() (&etext)
  485. #endif
  486.  
  487. static void
  488. DEFUN (continue_from_trap, (signo, info, scp),
  489.        int signo AND
  490.        SIGINFO_T info AND
  491.        struct FULL_SIGCONTEXT * scp)
  492. {
  493.   int pc_in_C;
  494.   int pc_in_heap;
  495.   int pc_in_constant_space;
  496.   int pc_in_scheme;
  497.   int pc_in_hyper_space;
  498.   int scheme_sp_valid;
  499.   long C_sp = (FULL_SIGCONTEXT_SP (scp));
  500.   long scheme_sp = (FULL_SIGCONTEXT_SCHSP (scp));
  501.   long the_pc = ((FULL_SIGCONTEXT_PC (scp)) & PC_VALUE_MASK);
  502.   SCHEME_OBJECT * new_stack_pointer;
  503.   SCHEME_OBJECT * xtra_info;
  504.   struct trap_recovery_info trinfo;
  505.  
  506. #if FALSE
  507.   fprintf (stderr, "\ncontinue_from_trap:");
  508.   fprintf (stderr, "\tpc = 0x%08lx\n", the_pc);
  509.   fprintf (stderr, "\tCsp = 0x%08lx\n", C_sp);
  510.   fprintf (stderr, "\tssp = 0x%08lx\n", scheme_sp);
  511.   fprintf (stderr, "\tesp = 0x%08lx\n", Ext_Stack_Pointer);
  512. #endif
  513.  
  514.   if ((the_pc & PC_ALIGNMENT_MASK) != 0)
  515.   {
  516.     pc_in_C = 0;
  517.     pc_in_heap = 0;
  518.     pc_in_constant_space = 0;
  519.     pc_in_scheme = 0;
  520.     pc_in_hyper_space = 1;
  521.   }
  522.   else
  523.   {
  524.     pc_in_C = (the_pc <= ((long) (get_etext ())));
  525.     pc_in_heap =
  526.       ((the_pc < ((long) Heap_Top)) && (the_pc >= ((long) Heap_Bottom)));
  527.     pc_in_constant_space =
  528.       ((the_pc < ((long) Constant_Top)) &&
  529.        (the_pc >= ((long) Constant_Space)));
  530.     pc_in_scheme = (pc_in_heap || pc_in_constant_space);
  531.     pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
  532.   }
  533.  
  534.   scheme_sp_valid =
  535.     (pc_in_scheme
  536.      && ((scheme_sp < ((long) Stack_Top)) &&
  537.      (scheme_sp >= ((long) Absolute_Stack_Base)) &&
  538.      ((scheme_sp & STACK_ALIGNMENT_MASK) == 0)));
  539.  
  540.   new_stack_pointer =
  541.     (scheme_sp_valid
  542.      ? ((SCHEME_OBJECT *) scheme_sp)
  543.      : (pc_in_C && (Stack_Pointer < Stack_Top)
  544.     && (Stack_Pointer > Absolute_Stack_Base))
  545.      ? Stack_Pointer
  546.      : ((SCHEME_OBJECT *) 0));
  547.  
  548.   if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
  549.   {
  550.     /* In hyper space. */
  551.     (trinfo . state) = STATE_UNKNOWN;
  552.     (trinfo . pc_info_1) = SHARP_F;
  553.     (trinfo . pc_info_2) = SHARP_F;
  554.     new_stack_pointer = 0;
  555.     if ((Free < MemTop) ||
  556.     (Free >= Heap_Top) ||
  557.     ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  558.     {
  559.       Free = MemTop;
  560.     }
  561.   }
  562.   else if (pc_in_scheme)
  563.   {
  564.     /* In compiled code. */
  565.     SCHEME_OBJECT * block_addr;
  566.     SCHEME_OBJECT * maybe_free;
  567.     block_addr =
  568.       (find_block_address (((PTR) the_pc),
  569.                (pc_in_heap ? Heap_Bottom : Constant_Space)));
  570.     if (block_addr == 0)
  571.     {
  572.       (trinfo . state) = STATE_PROBABLY_COMPILED;
  573.       (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
  574.       (trinfo . pc_info_2) = SHARP_F;
  575.       if ((Free < MemTop) ||
  576.       (Free >= Heap_Top) ||
  577.       ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  578.     Free = MemTop;
  579.     }
  580.     else
  581.     {
  582.       (trinfo . state) = STATE_COMPILED_CODE;
  583.       (trinfo . pc_info_1) =
  584.     (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr));
  585.       (trinfo . pc_info_2) =
  586.     (LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr)));
  587. #ifdef HAVE_FULL_SIGCONTEXT
  588.       maybe_free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
  589.       if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0)
  590.       && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top))
  591.       {
  592.     Free = (maybe_free + FREE_PARANOIA_MARGIN);
  593.       }
  594.       else
  595. #endif
  596.       {
  597.     if ((Free < MemTop) || (Free >= Heap_Top)
  598.         || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
  599.     {
  600.       Free = MemTop;
  601.     }
  602.       }
  603.     }
  604.   }
  605.   else
  606.   {
  607.     /* In the interpreter, a primitive, or a compiled code utility. */
  608.  
  609.     SCHEME_OBJECT primitive = (Regs[REGBLOCK_PRIMITIVE]);
  610.  
  611.     if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
  612.     {
  613.       (trinfo . state) = STATE_UNKNOWN;
  614.       (trinfo . pc_info_1) = SHARP_F;
  615.       (trinfo . pc_info_2) = SHARP_F;
  616.       new_stack_pointer = 0;
  617.     }
  618.     else
  619.     {
  620.       long primitive_address =
  621.     ((long) (Primitive_Procedure_Table[OBJECT_DATUM (primitive)]));
  622.       (trinfo . state) = STATE_PRIMITIVE;
  623.       (trinfo . pc_info_1) = primitive;
  624.       (trinfo . pc_info_2) =
  625.     (LONG_TO_UNSIGNED_FIXNUM (Regs[REGBLOCK_LEXPR_ACTUALS]));
  626.     }
  627.     if ((new_stack_pointer == 0)
  628.     || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)
  629.     || ((Free < Heap_Bottom) || (Free >= Heap_Top))
  630.     || ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop)))
  631.     {
  632.       Free = MemTop;
  633.     }
  634.     else if ((Free + FREE_PARANOIA_MARGIN) < MemTop)
  635.     {
  636.       Free +=  FREE_PARANOIA_MARGIN;
  637.     }
  638.   }
  639.   xtra_info = Free;
  640.   Free += (1 + 2 + PROCESSOR_NREGS);
  641.   (trinfo . extra_trap_info) =
  642.     (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info));
  643.   (*xtra_info++) =
  644.     (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + PROCESSOR_NREGS)));
  645.   (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
  646.   (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
  647.   {
  648.     int counter = FULL_SIGCONTEXT_NREGS;
  649.     int * regs = (FULL_SIGCONTEXT_FIRST_REG (scp));
  650.     while ((counter--) > 0)
  651.     {
  652.       (*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
  653.     }
  654.   }
  655.   /* We assume that regs,sp,pc is the order in the processor.
  656.      Scheme can always fix this. */
  657.   if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 0)
  658.   {
  659.     (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
  660.   }
  661.   if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 1)
  662.   {
  663.     (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
  664.   }
  665.   setup_trap_frame (signo, info, scp, (&trinfo), new_stack_pointer);
  666. }
  667.  
  668. /* Find the compiled code block in area which contains `pc_value'.
  669.    This attempts to be more efficient than `find_block_address_in_area'.
  670.    If the pointer is in the heap, it can actually do twice as
  671.    much work, but it is expected to pay off on the average. */
  672.  
  673. static SCHEME_OBJECT * EXFUN
  674.   (find_block_address_in_area, (char * pc_value, SCHEME_OBJECT * area_start));
  675.  
  676. #define MINIMUM_SCAN_RANGE        2048
  677.  
  678. static SCHEME_OBJECT *
  679. DEFUN (find_block_address, (pc_value, area_start),
  680.        char * pc_value AND
  681.        SCHEME_OBJECT * area_start)
  682. {
  683.   if (area_start == Constant_Space)
  684.     {
  685.       extern SCHEME_OBJECT * EXFUN
  686.     (find_constant_space_block, (SCHEME_OBJECT *));
  687.       SCHEME_OBJECT * constant_block =
  688.     (find_constant_space_block
  689.      ((SCHEME_OBJECT *)
  690.       (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK)));
  691.       return
  692.     ((constant_block == 0)
  693.      ? 0
  694.      : (find_block_address_in_area (pc_value, constant_block)));
  695.     }
  696.   {
  697.     SCHEME_OBJECT * nearest_word =
  698.       ((SCHEME_OBJECT *)
  699.        (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK));
  700.     long maximum_distance = (nearest_word - area_start);
  701.     long distance = maximum_distance;
  702.     while ((distance / 2) > MINIMUM_SCAN_RANGE)
  703.       distance = (distance / 2);
  704.     while ((distance * 2) < maximum_distance)
  705.       {
  706.     SCHEME_OBJECT * block =
  707.       (find_block_address_in_area (pc_value, (nearest_word - distance)));
  708.     if (block != 0)
  709.       return (block);
  710.     distance *= 2;
  711.       }
  712.   }
  713.   return (find_block_address_in_area (pc_value, area_start));
  714. }
  715.  
  716. /*
  717.   Find the compiled code block in area which contains `pc_value',
  718.   by scanning sequentially the complete area.
  719.   For the time being, skip over manifest closures and linkage sections. */
  720.  
  721. static SCHEME_OBJECT *
  722. DEFUN (find_block_address_in_area, (pc_value, area_start),
  723.        char * pc_value AND
  724.        SCHEME_OBJECT * area_start)
  725. {
  726.   SCHEME_OBJECT * first_valid = area_start;
  727.   SCHEME_OBJECT * area = area_start;
  728.   while (((char *) area) < pc_value)
  729.     {
  730.       SCHEME_OBJECT object = (*area);
  731.       switch (OBJECT_TYPE (object))
  732.     {
  733.     case TC_LINKAGE_SECTION:
  734.       {
  735.         switch (READ_LINKAGE_KIND (object))
  736.         {
  737.           case OPERATOR_LINKAGE_KIND:
  738.           case GLOBAL_OPERATOR_LINKAGE_KIND:
  739.           {
  740.         long count = (READ_OPERATOR_LINKAGE_COUNT (object));
  741.         area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1);
  742.         break;
  743.           }
  744.  
  745.           default:
  746. #if FALSE
  747.           {
  748.         gc_death (TERM_EXIT,
  749.               "find_block_address: Unknown compiler linkage kind.",
  750.               area, NULL);
  751.         /*NOTREACHED*/
  752.           }
  753. #else
  754.           /* Fall through, no reason to crash here. */
  755. #endif
  756.           case REFERENCE_LINKAGE_KIND:
  757.           case ASSIGNMENT_LINKAGE_KIND:
  758.             area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1);
  759.         break;
  760.  
  761.         }
  762.         break;
  763.       }
  764.     case TC_MANIFEST_CLOSURE:
  765.       {
  766.         area += 1;
  767.         {
  768.           long count = (MANIFEST_CLOSURE_COUNT (area));
  769.           area = ((MANIFEST_CLOSURE_END (area, count)) + 1);
  770.         }
  771.         break;
  772.       }
  773.     case TC_MANIFEST_NM_VECTOR:
  774.       {
  775.         long count = (OBJECT_DATUM (object));
  776.         if (((char *) (area + (count + 1))) < pc_value)
  777.           {
  778.         area += (count + 1);
  779.         first_valid = area;
  780.         break;
  781.           }
  782.         {
  783.           SCHEME_OBJECT * block = (area - 1);
  784.           return
  785.         (((area == first_valid) ||
  786.           ((OBJECT_TYPE (*block)) != TC_MANIFEST_VECTOR) ||
  787.           ((OBJECT_DATUM (*block)) < (count + 1)) ||
  788.           (! (PLAUSIBLE_CC_BLOCK_P (block))))
  789.          ? 0
  790.          : block);
  791.         }
  792.       }
  793.     default:
  794.       {
  795.         area += 1;
  796.         break;
  797.       }
  798.     }
  799.     }
  800.   return (0);
  801. }
  802.  
  803. #endif /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
  804.